PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/modula2/cal.com/TIME.MOD

Modula Implementation | 1989-06-03 | 10.7 KB | 417 lines

IMPLEMENTATION MODULE Time;

  IMPORT SYSTEM, IO, Lib, Window;

  CONST DaysPerYear = 365;
        DaysPerWeek = 7;

  VAR maxDay: ARRAY Month OF CARDINAL;
      daysBefore: ARRAY Month OF CARDINAL;

  PROCEDURE IsLeapYear(yr: CARDINAL): BOOLEAN;
  BEGIN
    RETURN (yr MOD 4 = 0) & (yr MOD 100 # 0) OR (yr MOD 400 = 0)
  END IsLeapYear;

  PROCEDURE NumDays(d: Date): LONGCARD;
    VAR result, leapYears: LONGCARD;
  BEGIN
    WITH d DO
      result := LONGCARD(da);
      INC( result, LONGCARD( daysBefore[mo] ) );
      INC( result, (LONGCARD(yr) - 1) * DaysPerYear);
      leapYears := LONGCARD((yr-1) DIV 4 - (yr-1) DIV 100 + (yr-1) DIV 400);
      INC( result, leapYears );
      IF (mo > Feb) & IsLeapYear(yr) THEN INC(result) END
    END;
    RETURN result
  END NumDays;

  PROCEDURE MakeDate(n: LONGCARD; VAR d: Date);

    PROCEDURE Before(mo: Month; yr: CARDINAL): CARDINAL;
      (* This routine is the procedure equivalent of
         the daysBefore array - except that it corrects
         for leap years.                                *)
      VAR i, max: Month;
          result: CARDINAL;
    BEGIN
      result := 0;
      IF mo # Jan THEN
        max := mo;
        DEC(max);
        FOR i := Jan TO max DO
          INC(result, maxDay[i]);
        END;
        IF (max > Jan) & IsLeapYear(yr) THEN
          INC(result)
        END
      END;
      RETURN result
    END Before;

    VAR c: CARDINAL;
        i: LONGCARD;
  BEGIN
    WITH d DO
      mo := Dec;
      da := 31;
      yr := CARDINAL(n DIV DaysPerYear);
      i := NumDays(d);
      WHILE i >= n DO
        DEC(yr);
        i := NumDays(d)
      END;
      INC(yr);
      c := CARDINAL(n - i);
      WHILE (mo > Jan) & (Before(mo, yr) >= c) DO
        DEC(mo)
      END;
      DEC(c, Before(mo, yr));
      da := c
    END
  END MakeDate;

  PROCEDURE DayOfWeek(d: Date): DayType;
    CONST Offset = 0;  (* empirically determined *)
  BEGIN
    RETURN VAL( DayType, NumDays(d) MOD DaysPerWeek + Offset )
  END DayOfWeek;

(**************************************************************************)

  MODULE Private;

    IMPORT IO, Window;                           (* modules *)
    IMPORT MinYear, MaxYear, DaysPerWeek;        (* constants *)
    IMPORT Date, Month;                          (* type *)
    IMPORT maxDay;                               (* variables *)
    IMPORT NumDays, DayOfWeek, IncDate, DecDate, (* procedures *)
           IsLeapYear;

    (* EXPORT *) IMPORT GetSelDate;  (* make this visible outside *)

    CONST Margin = 1;
          Between = 1;
          StartRow = 4;
          MaxDigits = 2;
          Width = 2 * Margin + DaysPerWeek * MaxDigits +
                               (DaysPerWeek-1) * Between + 2;

          Fore = Window.Black;        (* Basic black-and-white selected  *)
          Back = Window.LightGray;    (*   for portability in running on *)
          RevFore = Window.LightGray; (*   on different machines -       *)
          RevBack = Window.Black;     (*   especially laptops.           *)
          Intense = Window.White;

    VAR savedDate: Date;
        minDate, maxDate: Date;

    PROCEDURE OpenWindow(): Window.WinType;
      CONST Depth = 6 + 2 + StartRow - 1;
            Lft = (Window.ScreenWidth - Width) DIV 2;
            Top = (Window.ScreenDepth - Depth) DIV 2;
            Rgt = Lft + Width - 1;
            Btm = Top + Depth - 1;
      VAR WD: Window.WinDef;
          win: Window.WinType;
    BEGIN
      WITH WD DO
        X1 := Lft;
        Y1 := Top;
        X2 := Rgt;
        Y2 := Btm;
        Foreground := Fore;
        Background := Back;
        CursorOn := FALSE;
        WrapOn := FALSE;
        Hidden := FALSE;
        FrameOn := TRUE;
        FrameDef := Window.DoubleFrame;
        FrameFore := Intense;
        FrameBack := Back
      END;
      win := Window.Open(WD);
      RETURN win
    END OpenWindow;

    PROCEDURE DispDay(pos0: CARDINAL; d: Date);
      VAR x, y: CARDINAL;
    BEGIN
      x := Margin + ORD( DayOfWeek(d) ) * (MaxDigits+Between) + 1;
      y := (d.da + pos0 - 1) DIV DaysPerWeek + StartRow;
      Window.GotoXY(x, y);
      IO.WrCard( d.da, MaxDigits )
    END DispDay;

    PROCEDURE HiLite(pos0: CARDINAL; d: Date);
    BEGIN
      Window.TextColor( RevFore );
      Window.TextBackground( RevBack );

      DispDay(pos0, d);

      Window.TextColor( Fore );
      Window.TextBackground( Back )
    END HiLite;

    PROCEDURE WrMonth(mo: Month);
      VAR s: ARRAY [0..3] OF CHAR;
    BEGIN
      CASE mo OF
        Jan: s := "Jan"
      | Feb: s := "Feb"
      | Mar: s := "Mar"
      | Apr: s := "Apr"
      | May: s := "May"
      | Jun: s := "Jun"
      | Jul: s := "Jul"
      | Aug: s := "Aug"
      | Sep: s := "Sep"
      | Oct: s := "Oct"
      | Nov: s := "Nov"
      | Dec: s := "Dec"
      END;
      IO.WrStr(s)
    END WrMonth;

    PROCEDURE LastDay(mo: Month; yr: CARDINAL): CARDINAL;
      VAR da: CARDINAL;
    BEGIN
      da := maxDay[mo];
      IF (mo = Feb) & IsLeapYear(yr) THEN INC(da) END;
      RETURN da
    END LastDay;

    PROCEDURE DispCalendar(d: Date; startPos: CARDINAL);

      PROCEDURE WrHeading;
        CONST MonthCol = ((Width-2) - 8) DIV 2 + 1;
              DayLetter = "SMTWTFS";
        VAR i: CARDINAL;
      BEGIN
        Window.GotoXY(MonthCol, 1);
        WrMonth(d.mo);
        IO.WrCard(d.yr, 5);
        IO.WrLn; IO.WrLn;

        Window.TextColor( Intense );

        IO.WrCharRep(' ', Margin+1);
        IO.WrChar( DayLetter[0] );

        FOR i := 1 TO DaysPerWeek-1 DO
          IO.WrCharRep(' ', Between+1);
          IO.WrChar( DayLetter[i] )
        END;

        Window.TextColor( Fore );

        IO.WrLn
      END WrHeading;

      VAR i, max: CARDINAL;

    BEGIN
      Window.Clear;
      WrHeading;
      max := LastDay(d.mo, d.yr);

      FOR i := 1 TO max DO
        d.da := i;
        DispDay(startPos, d)
      END;

    END DispCalendar;

    PROCEDURE HandleScanCode(pos0: CARDINAL; VAR d: Date; VAR refresh: BOOLEAN);
      CONST (* scan codes *)
            home  = CHR(71); up    = CHR(72); pgUp  = CHR(73);
            left  = CHR(75);                  right = CHR(77);
            end   = CHR(79); down  = CHR(80); pgDn  = CHR(81);

            ctrlPgUp = CHR(132);
            ctrlPgDn = CHR(118);

      VAR sc: CHAR; (* scan code *)
          d0: Date; (* date on entry *)
          max: CARDINAL;
    BEGIN
      d0 := d;
      sc := IO.RdKey();

      CASE sc OF
        left:
          IF NumDays(d) > NumDays(minDate) THEN
            DispDay(pos0, d);
            DecDate(d, 1);
            HiLite(pos0, d)
          END
      | right:
          IF NumDays(d) < NumDays(maxDate) THEN
            DispDay(pos0, d);
            IncDate(d, 1);
            HiLite(pos0, d)
          END
      | up:
          IF NumDays(d) >= NumDays(minDate) + DaysPerWeek THEN
            DispDay(pos0, d);
            DecDate(d, DaysPerWeek);
            HiLite(pos0, d)
          END
      | down:
          IF NumDays(d) + DaysPerWeek <= NumDays(maxDate) THEN
            DispDay(pos0, d);
            IncDate(d, DaysPerWeek);
            HiLite(pos0, d)
          END
      | pgUp:
          IF d.mo > Jan THEN DEC(d.mo)
          ELSE
            IF d.yr > MinYear THEN
              DEC(d.yr);
              d.mo := Dec
            END
          END;
          max := LastDay(d.mo, d.yr);
          IF d.da > max THEN d.da := max END
      | pgDn:
          IF d.mo < Dec THEN INC(d.mo)
          ELSE
            IF d.yr < MaxYear THEN
              INC(d.yr);
              d.mo := Jan
            END
          END;
          max := LastDay(d.mo, d.yr);
          IF d.da > max THEN d.da := max END
      | ctrlPgUp:
          IF d.yr > MinYear THEN
            DEC(d.yr);
            IF (d.mo = Feb) & (d.da = 29) THEN
              d.da := LastDay(d.mo, d.yr)
            END
          END
      | ctrlPgDn:
          IF d.yr < MaxYear THEN
            INC(d.yr);
            IF (d.mo = Feb) & (d.da = 29) THEN
              d.da := LastDay(d.mo, d.yr)
            END
          END
      | home:
          DispDay(pos0, d);
          d := savedDate;
          HiLite(pos0, d)
      END;
      refresh := (d.mo # d0.mo) OR (d.yr # d0.yr)
    END HandleScanCode;

    PROCEDURE GetSelDate(VAR d: Date; VAR abort: BOOLEAN);
      CONST nul = 0C;
            cr  = 15C;
            esc = 33C;
      VAR win: Window.WinType;
          ch: CHAR;
          refresh: BOOLEAN;      (* rebuild display *)
          startPos: CARDINAL;    (* horizontal offset *)
          savedDay: CARDINAL;
    BEGIN
      savedDate := d;
      win := OpenWindow();
      refresh := TRUE;
      REPEAT
        IF refresh THEN
          savedDay := d.da;
          d.da := 1;
          startPos := ORD( DayOfWeek(d) );
          d.da := savedDay;

          DispCalendar(d, startPos);
          HiLite(startPos, d)
        END;
        ch := IO.RdKey();
        IF ch = nul THEN HandleScanCode(startPos, d, refresh) END
      UNTIL (ch = esc) OR (ch = cr);

      abort := ch = esc;
      IF abort THEN d := savedDate END;
      Window.Close(win)
    END GetSelDate;

  BEGIN
    WITH minDate DO
      mo := Jan;
      da := 1;
      yr := MinYear
    END;
    WITH maxDate DO
      mo := Dec;
      da := 31;
      yr := MaxYear
    END
  END Private;

(**************************************************************************)

  PROCEDURE IncDate(VAR d: Date; n: LONGCARD);
    VAR i: LONGCARD;
  BEGIN
    WITH d DO
      i := NumDays(d);
      INC(i, n);
      MakeDate(i, d)
    END
  END IncDate;

  PROCEDURE DecDate(VAR d: Date; n: LONGCARD);
    VAR i: LONGCARD;
  BEGIN
    WITH d DO
      i := NumDays(d);
      DEC(i, n);
      MakeDate(i, d)
    END
  END DecDate;

  PROCEDURE GetSysDate(VAR d: Date; VAR dayOfWeek: DayType);
    VAR r: SYSTEM.Registers;
  BEGIN
    WITH r DO
      AH := 2AH;

      Lib.Dos(r);

      dayOfWeek := DayType(AL);
      d.yr := CX;
      d.mo := VAL( Month, DH-1 );
      d.da := CARDINAL(DL)
    END
  END GetSysDate;

  PROCEDURE InitData;
    VAR mo: Month;
  BEGIN
    maxDay[Jan] := 31;
    maxDay[Feb] := 28;  (* adjust for leap years later *)
    maxDay[Mar] := 31;
    maxDay[Apr] := 30;
    maxDay[May] := 31;
    maxDay[Jun] := 30;
    maxDay[Jul] := 31;
    maxDay[Aug] := 31;
    maxDay[Sep] := 30;
    maxDay[Oct] := 31;
    maxDay[Nov] := 30;
    maxDay[Dec] := 31;

    daysBefore[Jan] := 0;
    FOR mo := Jan TO Nov DO
      daysBefore[ VAL( Month, ORD(mo)+1 ) ] := daysBefore[mo] + maxDay[mo];
    END
  END InitData;

BEGIN
  InitData
END Time.